home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Celestin Apprentice 5
/
Apprentice-Release5.iso
/
Source Code
/
C
/
Applications
/
GW AdaEd 1.4.2
/
GWAdaDemos
/
NYUDemos
/
CLI.ADA
next >
Wrap
Text File
|
1994-01-09
|
11KB
|
297 lines
-- **************************************
-- * *
-- * CLI (Command Line Interface) * SPEC
-- * *
-- **************************************
package CLI is
--| Purpose
--| CLI is a package which implements a Command
--| Line Interface. It mirrors the UNIX/C
--| command line interface, providing an argument
--| count and the arguments themselves.
--|
--| Initialization Exceptions (none)
--|
--| Notes
--| Compiler limit on string length and dynamic memory.
--| INITIALIZE must be called once, and only once, during
--| the execution of the main Ada proc.
--|
--| Modifications
--| 2/25/88 Richard Conn Initial Version
--| 5/12/89 Richard Conn Review and Upgrade
--| 4/11/90 Richard Conn MIL-HDBK-1804 Annotations and
--| Meridian Ada Interface Added
-- ...................................
-- . .
-- . CLI.INITIALIZE . SPEC
-- . .
-- ...................................
procedure Initialize (Program_Name : in STRING;
Command_Line_Prompt : in STRING);
--| Purpose
--| Initialize this package. This routine must be called
--| before any other routines or objects are called or referenced.
--|
--| Exceptions (none)
--|
--| Notes
--| CALL THIS PROCEDURE ONLY ONE TIME
-- ...................................
-- . .
-- . CLI.ARGC (Argument Count) . SPEC
-- . .
-- ...................................
function ArgC return NATURAL;
--| Purpose
--| Return the number (1 to N) of command line arguments.
--| ARGC is at least 1 because the name of the program or
--| process is always ARGV(0).
--|
--| Exceptions (none)
--| Notes (none)
-- ...................................
-- . .
-- . CLI.ARGV (Argument Value) . SPEC
-- . .
-- ...................................
function ArgV (Index : in NATURAL) return STRING;
--| Purpose
--| Return the INDEXth (0 <= INDEX < ARGC) command line
--| argument. Example: if ARGC = 1, ARGV(0) is the only
--| valid argument string. ARGV(0) is always the name of
--| the program or process.
--|
--| Exceptions
--| INVALID_INDEX raised if Index >= ARGC
--|
--| Notes (none)
INVALID_INDEX : exception;
UNEXPECTED_ERROR : exception; -- raised anytime
end CLI;
-- This implementation of Package Body CLI is general-purpose.
-- Using TEXT_IO, it prompts the user for input arguments and
-- accepts these arguments via a GET_LINE call.
with TEXT_IO;
package body CLI is
LOCAL_ARGC : NATURAL := 0;
package STRING_LIST is
NUMBER_OF_STRINGS : NATURAL := 0;
procedure ADD_TO_LIST (ITEM : in STRING);
function GET_FROM_LIST (ITEM : in NATURAL) return STRING;
end STRING_LIST;
package body STRING_LIST is
type DYNAMIC_STRING_OBJECT (LENGTH : NATURAL);
type DYNAMIC_STRING is access DYNAMIC_STRING_OBJECT;
type DYNAMIC_STRING_OBJECT (LENGTH : NATURAL) is
record
DS : STRING (1 .. LENGTH);
NEXT : DYNAMIC_STRING;
end record;
FIRST : DYNAMIC_STRING := null;
LAST : DYNAMIC_STRING := null;
procedure ADD_TO_LIST (ITEM : in STRING) is
--========================= PDL ===========================
--|ABSTRACT:
--| ADD_TO_LIST adds the ITEM string to the linked list
--| of dynamic strings implemented by this package.
--|DESIGN DESCRIPTION:
--| Create new DYNAMIC_STRING_OBJECT of the proper length
--| Set DS field of new object to the ITEM string
--| Set the NEXT field of the new object to NULL
--| If FIRST pointer is null
--| Set FIRST and LAST to point to the new object
--| Else
--| Set LAST.NEXT to point to the new object
--| Set LAST to point to the new object
--| End if
--| Increment NUMBER_OF_STRINGS
--=========================================================
TEMP : DYNAMIC_STRING;
begin
TEMP := new DYNAMIC_STRING_OBJECT (ITEM'LENGTH);
TEMP.DS (1 .. ITEM'LENGTH) := ITEM;
TEMP.NEXT := null;
if FIRST = null then
FIRST := TEMP;
LAST := TEMP;
else
LAST.NEXT := TEMP;
LAST := TEMP;
end if;
NUMBER_OF_STRINGS := NUMBER_OF_STRINGS + 1;
end ADD_TO_LIST;
function GET_FROM_LIST (ITEM : in NATURAL) return STRING is
--========================= PDL ===========================
--|ABSTRACT:
--| GET_FROM_LIST returns the ITEM string from the linked list
--| of dynamic strings implemented by this package.
--|DESIGN DESCRIPTION:
--| If ITEM > 0
--| Advance to desired item
--| End If
--| Return the DS field of the desired item
--=========================================================
ROVER : DYNAMIC_STRING := FIRST;
begin
if ITEM > 0 then
for I in 1 .. ITEM loop
ROVER := ROVER.NEXT;
end loop;
end if;
return ROVER.DS;
end GET_FROM_LIST;
end STRING_LIST;
procedure INITIALIZE (PROGRAM_NAME : in STRING;
COMMAND_LINE_PROMPT : in STRING) is
--========================= PDL ===========================
--|ABSTRACT:
--| INITIALIZE prompts the user for the command line
--| arguments and loads the linked list with them.
--|DESIGN DESCRIPTION:
--| Set CURRENT_STATE to LOOKING_FOR_TOKEN
--| Set the first list object to PROGRAM_NAME
--| Prompt the user with COMMAND_LINE_PROMPT and
--| get his response
--| Over number of characters in line, loop
--| Case CURRENT_STATE
--| When LOOKING_FOR_TOKEN
--| If character is not white-space
--| Set CURRENT_STATE to IN_TOKEN
--| If character is quote (")
--| Set QUOTED to TRUE
--| Set START to the character's index + 1
--| Else
--| Set QUOTED to FALSE
--| Set START to the character's index
--| End IF
--| End If
--| When IN_TOKEN
--| If QUOTED
--| If character is quote (")
--| Set STOP to the previous character's index
--| Add slice from START to STOP to list
--| Set CURRENT_STATE to LOOKING_FOR_TOKEN
--| End If
--| ElsIF character is white-space
--| Set STOP to the previous character's index
--| Add slice from START to STOP to list
--| Set CURRENT_STATE to LOOKING_FOR_TOKEN
--| End If
--| End Case
--| End Loop
--| If CURRENT_STATE is IN_TOKEN
--| Set STOP to the previous character's index
--| Add slice from START to STOP to list
--| End if
--| Set LOCAL_ARGC to NUMBER_OF_STRINGS
--| Output NEW_LINE (to reset column count in TEXT_IO)
--=========================================================
ARGCOUNT : NATURAL := 1;
INLINE : STRING (1 .. 400);
LAST : NATURAL;
START : NATURAL;
STOP : NATURAL;
QUOTED : BOOLEAN;
type STATE is (LOOKING_FOR_TOKEN, IN_TOKEN);
CURRENT_STATE : STATE := LOOKING_FOR_TOKEN;
begin
STRING_LIST.ADD_TO_LIST (PROGRAM_NAME);
TEXT_IO.PUT (COMMAND_LINE_PROMPT);
TEXT_IO.GET_LINE (INLINE, LAST);
for I in 1 .. LAST loop
case CURRENT_STATE is
when LOOKING_FOR_TOKEN =>
if INLINE (I) > ' ' then
CURRENT_STATE := IN_TOKEN;
if INLINE (I) = '"' then
QUOTED := TRUE;
START := I;
else
QUOTED := FALSE;
START := I;
end if;
end if;
when IN_TOKEN =>
if QUOTED then
if INLINE (I) = '"' then
STOP := I;
STRING_LIST.ADD_TO_LIST (INLINE (START .. STOP));
CURRENT_STATE := LOOKING_FOR_TOKEN;
end if;
elsif INLINE (I) <= ' ' then
STOP := I - 1;
STRING_LIST.ADD_TO_LIST (INLINE (START .. STOP));
CURRENT_STATE := LOOKING_FOR_TOKEN;
end if;
end case;
end loop;
if CURRENT_STATE = IN_TOKEN then
STOP := LAST;
STRING_LIST.ADD_TO_LIST (INLINE (START .. STOP));
end if;
LOCAL_ARGC := STRING_LIST.NUMBER_OF_STRINGS;
TEXT_IO.NEW_LINE;
end INITIALIZE;
function ARGC return NATURAL is
--========================= PDL ===========================
--|ABSTRACT:
--| ARGC returns the argument count.
--|DESIGN DESCRIPTION:
--| Return LOCAL_ARGC
--=========================================================
begin
return LOCAL_ARGC;
end ARGC;
function ARGV (INDEX : in NATURAL) return STRING is
--========================= PDL ===========================
--|ABSTRACT:
--| ARGV returns the indicated argument string.
--|DESIGN DESCRIPTION:
--| If INDEX is out of range, raise INVALID_INDEX
--| Return GET_FROM_LIST(INDEX)
--=========================================================
begin
if INDEX >= LOCAL_ARGC then
raise INVALID_INDEX;
end if;
return STRING_LIST.GET_FROM_LIST (INDEX);
exception
when INVALID_INDEX =>
raise ;
when others =>
raise UNEXPECTED_ERROR;
end ARGV;
end CLI;
